home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
BASIC
/
2789.ZIP
/
M3TEST.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-09-28
|
10KB
|
260 lines
DECLARE SUB Monocheck ()
'/TEST PROGRAM FOR MENU 3 + POPHELP.
' Note that INCLUDEd files and the help text file MENU3.HLP must be
' available in the default drive/directory. The directory containing
' INCLUDE files may be specified via the Options/Set paths... menu.
' If you want the program to look for MENU3.HLP in a directory other
' than the default find helpath$ below and change it's assignment/
'$INCLUDE: 'MENU3DCL.BI' '/FUNCTION declarations needed for Menu3/
DEFINT A-Z '/default for this module/
'/dimension arrays to hold main and submenu selections, quick
' keys and help page pointers. DIM to the number of main menu
' entries and number of longest submenu entries PLUS 1. This
' menu implementation has five main menu entries and the longest
' submenu has 12/
DIM menu$(1 TO 6, 1 TO 13) '/main & submenu selections/
DIM qkey(1 TO 6, 1 TO 13) '/quick key selections/
DIM query$(1 TO 6, 1 TO 13) '/query$ is used to hold uppercase letters in
' the range A-Z. These control the context
' sensitivity of Pophelp when it is called
' from within an open menu. Each letter
' refers to a single page in a help text file.
' The letters are coded in the DATA statements
' also used to define menu entries and quick
' key selections. See manual QUICKREF.DOC and
' study the DATA statements at the end
' of this Module/
DIM spectrum(16) '/spectrum(0..5) holds menus colours.
' spectrum(8..11) holds Pophelp colours.
' other spectrum() locations are used for
' other colours needed in this module.
' Study SUB Monocheck/
menuentries = 5 '/5 main menu selections this implementation.
' Make sure you define the number of main menu
' entries before you call up the following
' INCLUDE file/
'$INCLUDE: 'MENU34.BI' '/call up a routine to fill menu$(), qkey()
' and query$() from DATA statements/
'/go set colours according to monitor in use/
CALL Monocheck '/not a quick library subroutine/
'**********************************************************************
'/This section of code (between the asterisks) is included for
' demonstration purposes only and may be deleted without
' affecting the operation of the Menus or Pophelp/
'/Fill screen with test background/
LOCATE 1, 1
CALL clrbox(spectrum(12), 80, 24) '/see manual QUICKREF.DOC for details/
'/do prompt line along row 25/
COLOR spectrum(13), spectrum(14)
LOCATE 25, 1
PRINT " Menu3 + Pophelp "; CHR$(179);
PRINT " F10 to Open Menu F1 to call Help Alt+X to Exit ";
'**************************************************************************
'/going to use Pophelp so we need to intialise/
code$ = "08125414" '/Pophelp will pop up screen row 08, column 12
' with a page size (including border) 54 columns
' wide and 14 rows deep. Include leading zeros
' where necessary, code$ must contain 8 digits/
context$ = "X" '/if we call Pophelp from outside the menu (i.e.
' from this module) it will pop up displaying the
' index/
helpath$ = "MENU3.HLP" '/tell Pophelp where it can find
' the help text file/
CALL HelpInit(helpath$) '/pass Pophelp the
CALL Popcode(code$, spectrum()) ' information it needs/
'**********************************
'/now complete menu initialisation/
'**********************************
CALL M3Init(menuentries, menu$()) '/M3Init works out the
' size of the menus/
keycode = 0 '/keycode is needed by keypress()/
sh = 1 '/turn on shadowing. sh = 0 turns it off/
mrow = 2 '/screen row position of top of main menu bar/
mcol = 4 '/screen column position LH edge of main menu bar/
'**********************************************************************
'/Ready to go. Wait for call to display Menu3 or Pophelp Index or Quit/
'**********************************************************************
DO
CALL keypress(keycode, 1) '/wait for user input. See
' QUICKREF.DOC for details on
' using keypress()/
SELECT CASE keycode
CASE 1068 '/F10 key calls menu/
'/open the menu/
CALL M3Open(menu$(), qkey(), query$(), spectrum(), sh, mrow, mcol)
'/the menu is now open and control will not return to here until the user
' either makes a selection or presses the Escape key/
'/FUNCTION Getkey3 will return 13 if a selection was made. If the user
' dismissed the menu by pressing Escape then Getkey3 will return 27, in
' which case the menu will already have been cleared from the screen/
IF Getkey3 = 13 THEN '/a selection was made/
mainselection$ = RTRIM$(menu$(1, Getmain3)) '/extract main and
subselection$ = menu$(Getmain3 + 1, Getsub3) ' submenu selections
' from menu$()/
COLOR 0, 7
LOCATE 23, 3: PRINT SPACE$(34)
LOCATE 22, 3
PRINT " Your last menu selection was: ";
LOCATE 23, 4
PRINT mainselection$; "/"; subselection$; '/display selections/
IF subselection$ = "Call POPHELP Index" THEN
CALL PopHelp(context$, sh) '/open Pophelp in
END IF ' response to menu
' selection/
CALL M3Close '/dismiss menus. You must explicitly
END IF ' dismiss the menu when a selection
' has been made. If the user presses
' <Escape> to dismiss the menu it is
' dismissed automatically/
CASE 1045 '/Alt + X to terminate program/
EXIT DO
CASE 1059 '/F1 key also calls Pophelp from here/
CALL PopHelp(context$, sh)
END SELECT
LOOP
'************************
'/DATA statements follow/
'************************
'/Main menu selections/
'/Use trailing spaces to format your entries along the main menu bar.
' It's up to you not to overlap the RH end. Note that each selection is
' followed by a number and an uppercase letter. The number represents the
' POSITION in the preceding selection of the 'quick key' letter you want to
' highlight. The uppercase letter is the index to the help page you want
' Pophelp to display if the user presses F1 while the menu is open and
' the associated selection is highlighted. Each group of menu selections
' must end with ,#/
DATA "Stars ",1,C,"Constellations ",1,C,"Planets ",1,C
DATA "Signs ",2,C,Help,1,C,#
'/Submenu selections/
'/Do not use any leading/trailing spaces in sub menu selections. If you
' want to place horizontal dividers in any submenu then code *,0,Z, in the
' positions you want (see 'Earth' in the 3rd. set of DATA statements below).
' Don't forget that a horizontal divider counts as one selection when you
' are totalling selections for the purposes of DIMensioning menu$() etc.
' Submenu selection lists must also end with ,#/
DATA Arcturus,1,D,Betelgeuse,1,D,Sirius,1,D,Aldebaran,3,D
DATA Formalhaut,1,D,Canopus,1,D,Zubenelgenubi,1,D,#
DATA Canis Major,1,D,Cassiopeia,7,D,Andromeda,1,D
DATA Ursa Minor,1,D,Corona Borealis,8,D,#
DATA Mercury,3,D,Venus,1,D,*,0,Z,Earth,1,D,*,0,Z,Mars,1,D
DATA Jupiter,1,D,Saturn,1,D,Uranus,1,D,Neptune,1,D,Pluto,1,D,#
DATA Capricorn,1,D,Aquarius,1,D,Pisces,1,D,Aries,2,D,Taurus,1,D,Gemini,1,D
DATA Cancer,3,D,Leo,1,D,Virgo,1,D,Libra,2,D,Scorpio,3,D,Sagittarius,1,D,#
DATA Call POPHELP Index,14,X,#
END
SUB Monocheck STATIC
SHARED spectrum()
COLOR 7, 0
CLS
LOCATE 2, 3
PRINT "Press <C> for Colour"
LOCATE 3, 3
PRINT "Press <M> for Monochrome"
DO
sel$ = INKEY$
IF UCASE$(sel$) = "M" THEN
'/not colour so set for mono monitor/
spectrum(0) = 15
spectrum(1) = 0
spectrum(2) = 0
spectrum(3) = 7
spectrum(4) = 15
spectrum(5) = 0
spectrum(6) = 0
spectrum(8) = 0
spectrum(9) = 7
spectrum(10) = 0
spectrum(11) = 15
spectrum(12) = 0
spectrum(13) = 0
spectrum(14) = 7
EXIT DO
ELSEIF UCASE$(sel$) = "C" THEN
'/Allocate menu colours/
spectrum(0) = 14 '/highlighted letters (quick keys)/
spectrum(1) = 10 '/menu border/
spectrum(2) = 11 '/menu text/
spectrum(3) = 1 '/menu background/
spectrum(4) = 0 '/selected entries text/
spectrum(5) = 7 '/selected entries background/
'/allocate Pophelp colours/
spectrum(8) = 14 '/page text/
spectrum(9) = 6 '/background/
spectrum(10) = 10 '/border/
spectrum(11) = 15 '/border text/
'/other colours needed for program/
spectrum(12) = 2 '/screen backgound colour/
spectrum(13) = 0 '/initial prompt line foreground/
spectrum(14) = 7 '/initial prompt line background/
EXIT DO
END IF
LOOP
END SUB